;; the bookmaker cross buffers
;; some functions steal from bm.el
;; author panxq
;; create time: 2011-03-22 13:10:53

(defvar my-bm-trace1 nil)

(defvar my-bm-trace2 nil)

(defvar my-bm-trace-curr nil)

(defface my-bm-face
  '((((class grayscale)
      (background light)) (:background "DimGray"))
    (((class grayscale)
      (background dark))  (:background "LightGray"))
    (((class color)
      (background light)) (:foreground "White" :background "DarkOrange1"))
    (((class color)
      (background dark))  (:foreground "Black" :background "DarkOrange1")))
  "Face used to highlight current line.")

;; the bookmaker item type is like this
;; (buffer marker)

;; utility functions
(defun my-bm-bookmark-at (point)
  "Get bookmark at POINT."
  (let ((overlays (overlays-at point))
        (bookmark nil)
        c)
    (while (and (not bookmark) overlays)
      (setq c (car overlays)
            overlays (cdr overlays))
      (when (string= (overlay-get c 'category) "my-bm")
        (setq bookmark c)))
    bookmark))

(defun my-bm-remove-trace (trace buffer &optional marker)
  (when trace
    (delq nil
          (mapcar
           (lambda (item)
             (if (and (equal buffer (car item))
                      (if marker (equal marker (car (cdr item))) t))
                 nil
               item))
           trace))))

(defun my-bm-remove-trace-curr (buffer &optional marker)
  (when my-bm-trace-curr
    (when (and (equal buffer (car my-bm-trace-curr))
               (if marker
                   (equal marker (car (cdr my-bm-trace-curr)))
                 t))
      (setq my-bm-trace-curr nil))))

(defun my-bm-need-margin (width)
  (when (< left-margin-width width)
    (setq left-margin-width width)
    (set-window-margins (selected-window) width 0)))

(defun my-bm-bookmark-remove (bookmark)
  "remove the bookmark from traces, and the current bookmark.
the bookmark is a overlay"
  (let ((buffer (overlay-get bookmark 'my-buffer))
        (marker (overlay-get bookmark 'my-marker)))
    (setq my-bm-trace1 (my-bm-remove-trace
                        my-bm-trace1 buffer marker))
    (setq my-bm-trace2 (my-bm-remove-trace
                        my-bm-trace2 buffer marker))
    (my-bm-remove-trace-curr buffer marker)
    (delete-overlay bookmark)))

(defun my-bm-bookmark-add ()
  "Add bookmark at current line. return the bookmark.
Only apply in not empty line"
  (when (> (line-end-position) (line-beginning-position))
    (let* ((bookmark (make-overlay (line-beginning-position)
                                   (line-end-position)))
           (buffer (current-buffer))
           (marker (point-marker))
           (item (list buffer marker)))
      ;; (my-bm-need-margin 1)
      (overlay-put bookmark 'my-buffer buffer)
      (overlay-put bookmark 'my-marker marker)
      (overlay-put bookmark 'face 'my-bm-face)
      (overlay-put bookmark 'category "my-bm")
      ;; add to the trace1 list
      (when my-bm-trace-curr
        (push my-bm-trace-curr my-bm-trace1))
      (setq my-bm-trace-curr item))))

(defun my-bm-trace-merge ()
  (when my-bm-trace2
    (dolist (item my-bm-trace2)
      (push item my-bm-trace1))
    (setq my-bm-trace2 nil)))

(defun my-bm-jump-to ()
  (when my-bm-trace-curr
    (switch-to-buffer (car my-bm-trace-curr))
    (goto-char (car (cdr my-bm-trace-curr)))))

;;;###autoload
(defun my-bm-clear-bookmarks-curr-buffer ()
  (interactive)
  (let ((overlays (overlays-in (point-min) (point-max))))
    (dolist (overlay overlays)
      (when (string= (overlay-get overlay 'category) "my-bm")
        (delete-overlay overlay)))
    (setq my-bm-trace1 (my-bm-remove-trace
                        my-bm-trace1 (current-buffer)))
    (setq my-bm-trace2 (my-bm-remove-trace
                        my-bm-trace2 (current-buffer)))
    (my-bm-remove-trace-curr (current-buffer))))

;;;###autoload
(defun my-bm-toggle ()
  "Toggle bookmark at point."
  (interactive)
  (save-excursion
    (beginning-of-line)
    (let ((bookmark (my-bm-bookmark-at (point))))
      (if bookmark
          (my-bm-bookmark-remove bookmark)
        (my-bm-bookmark-add)))))

;;;###autoload
(defun my-bm-next ()
  (interactive)
  (when my-bm-trace2
    (when my-bm-trace-curr
      (push my-bm-trace-curr my-bm-trace1))
    (setq my-bm-trace-curr (car my-bm-trace2)
          my-bm-trace2 (cdr my-bm-trace2)))
  (my-bm-jump-to))

;;;###autoload
(defun my-bm-previous ()
  (interactive)
  (when my-bm-trace1
    (when my-bm-trace-curr
      (push my-bm-trace-curr my-bm-trace2))
    (setq my-bm-trace-curr (car my-bm-trace1)
          my-bm-trace1 (cdr my-bm-trace1)))
  (my-bm-jump-to))

(defvar my-bm-show-buffer-overlays nil)

(defface my-bm-show-face
  '((((class color)) (:foreground "Green"))
    (t (:bold t)))
  "green face")

(defface my-bm-show-mouse-face
  '((((class color)) (:foreground "Green" :bold t :underline t))
    (t (:bold t)))
  "green face")

(defun my-bm-print-bookmark (buffer marker)
  (let* ((name (buffer-name buffer))
         line lineno overlay pt)
    (save-excursion
      (set-buffer buffer)
      (goto-char (marker-position marker))
      (setq line (buffer-substring-no-properties
                  (line-beginning-position) (line-end-position))
            lineno (line-number-at-pos)))
    ;; print the information to the *bookmark* buffer
    (setq pt (point))
    (insert (format "%s:%d" name lineno))
    (setq overlay (make-overlay pt (point)))
    (overlay-put overlay 'face 'my-bm-show-face)
    (overlay-put overlay 'mouse-face 'my-bm-show-mouse-face)
    (overlay-put overlay 'keymap my-bm-map)
    (overlay-put overlay 'my-buffer buffer)
    (overlay-put overlay 'my-marker marker)
    (insert (format "\t%s\n" line))
    ;; save the overlay to overlays list
    (push overlay my-bm-show-buffer-overlays)
    ))

(defun my-bm-click ()
  (interactive)
  (let ((overlays (overlays-at (point))) overlay
        buffer marker)
    (when overlays
      (setq overlay (car overlays))
      (setq buffer (overlay-get overlay 'my-buffer)
            marker (overlay-get overlay 'my-marker))
      (when (and buffer marker)
        (set-buffer buffer)
        (goto-char marker)
        (switch-to-buffer buffer)))))

(defun my-bm-click-mouse (event)
  (interactive "e")
  (select-window (posn-window (event-end event)))
  (set-buffer (window-buffer (posn-window (event-end event))))
  (goto-char (posn-point (event-end event)))
  (my-bm-click))

(defvar my-bm-map (make-sparse-keymap))

(define-key my-bm-map [(down-mouse-1)]
  (lambda () (interactive) t))

(define-key my-bm-map [(mouse-1)] 'my-bm-click-mouse)
(define-key my-bm-map [(return)] 'my-bm-click)

;;;###autoload
(defun my-bm-show-all ()
  (interactive)
  (let ((buffer (get-buffer-create "*bookmark*")))
    ;; prepare
    (set-buffer buffer)
    (toggle-read-only -1)
    (buffer-disable-undo)
    (erase-buffer)

    (when my-bm-trace2
      (let ((r (reverse my-bm-trace2)))
        (dolist (item r)
          (my-bm-print-bookmark (car item)
                                (car (cdr item))))))

    (when my-bm-trace-curr
      (my-bm-print-bookmark (car my-bm-trace-curr)
                            (car (cdr my-bm-trace-curr))))

    (when my-bm-trace1
      (dolist (item my-bm-trace1)
        (my-bm-print-bookmark (car item)
                              (car (cdr item)))))

    ;; ending
    (goto-char (point-min))
    (toggle-read-only)
    (display-buffer buffer)))

(add-hook 'kill-buffer-hook 'my-bm-clear-bookmarks-curr-buffer)

(provide 'my-bookmark)
